home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / arvis1 / gamemod.bas < prev    next >
BASIC Source File  |  1999-10-09  |  6KB  |  160 lines
  1. Attribute VB_Name = "GameMod"
  2. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  3. ' This Module Holds API Call's, Variables and Constants For The Game '
  4. '____________________________________________________________________'
  5. Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  6. Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  7. Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  8. Global XSpeed As Integer, BallX As Integer
  9. Global YSpeed As Integer, BallY As Integer
  10. Global FastSpeed As Integer
  11. Global NumBounces As Long
  12. Global StartTime As Date
  13. Global LivesLeft As Integer
  14. Global GamePicsLoaded  As Boolean
  15. Global TitlePicsLoaded  As Boolean
  16. Global LoadPercent As Integer
  17. Global ParentForm As Form
  18. Global CmdSpeedParam As Integer
  19. Public Const Clock = 1
  20. Public Const AntiClock = 2
  21. ' Some Scrolling Text Shapes
  22. Public Const B = "░", BB = "▒", BBB = "▓"
  23. Public Const BBBB = "█", RR = "₧", UpExcla = "■"
  24. Public Const LL = "¡"
  25.  
  26. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  27. ' This Is The First Sub To Load Up   '
  28. '____________________________________'
  29. Public Sub Main()
  30. Dim Result As VbMsgBoxResult
  31. StopSounds True, True
  32. ' Get The Current Resolution
  33. ' and Load The Correct Form.
  34. ' I Decided to To Have One Small Form
  35. ' And One Large Form Rather The Changing The Res
  36. ' Because It Was Easier, And The Change Res Code
  37. ' gave me probs when trying to change back to the original res
  38. '
  39. ' set the speed from the paramerter given from the launcher
  40. '
  41. If Trim(Command()) = "" Then
  42.  MsgBox "   Please Start Quad-Ball From The Quad-Ball Launcher.   ", vbOKOnly, "Quad-Ball"
  43.  Result = MsgBox("   Do You Want To Load The Quad-Ball Launcher ?   ", vbYesNo)
  44.  If Result = vbYes Then
  45.    ThisDir
  46.    Shell "LaunchQuadball.exe", vbNormalFocus
  47.    End
  48.   Else
  49.    MsgBox "   Quad-Ball Will Now Exit   "
  50.    End
  51.  End If
  52. Else
  53.   CmdSpeedParam = Int(Val(Command()))
  54.   If CmdSpeedParam < 5 Then CmdSpeedParam = 5
  55.   'If CmdSpeedParam > 200 Then CmdSpeedParam = 200 put down a limit
  56. End If
  57.  
  58. If Screen.Width = (800 * Screen.TwipsPerPixelX) Then
  59.  Set ParentForm = TrainFrm
  60.  Load TrainFrm
  61. ElseIf Screen.Width > (800 * Screen.TwipsPerPixelX) Then
  62.  Set ParentForm = TrainLarge
  63.  Load TrainLarge
  64. ElseIf Screen.Width < (800 * Screen.TwipsPerPixelX) Then
  65.  Dim NewLine As String
  66.  NewLine = Chr(13) & Chr(13)
  67.  MsgBox "This Game Requires A Resolution Of At Least 800 X 600." & NewLine & _
  68.  "To Increase Your Resolution Follow These Steps:" & NewLine & _
  69.  "1) Right Click On The Desktop." & NewLine & _
  70.  "2) Select Properties From The Menu." & NewLine & _
  71.  "3) Select The Settings Tab In The Dialog Which Appears." & NewLine & _
  72.  "4) Slide The Screen Area Scroller To A Higher Resolution (i.e. 800 X 600)." & NewLine & _
  73.  "5) If The ScrollBar Is Not There Your Monitor Doesn't Support The Reolution So You Can Not Play This Game.", _
  74.   vbOKOnly, "Cannot Run, Contact Arvinder@Sehmi.co.uk For Further Help."
  75. End
  76. End If
  77. End Sub
  78. ' Sub Is Used Loads All Pictures ( *.img )
  79. Public Sub LoadPic(Destination As Object, File As String)
  80.  On Error GoTo Handel1
  81.  LoadPercent = LoadPercent + 1
  82.  TrainLoadUp.Caption = LoadPercent
  83.  TrainLoadUp.CurrLoad.Caption = "Loading Pictures...( " & File & " )"
  84.  ThisDir
  85.  TrainLoadUp.Refresh
  86.  Destination.Picture = LoadPicture(File)
  87.  Exit Sub
  88. Handel1:
  89. MsgBox "Error:" & Chr(13) & Chr(13) & _
  90.        "There Is a Missing File (" & File & _
  91.        ") Which is Needed By This Game," & Chr(13) & _
  92.        "Please Re-Install Quad-Ball, So The Error Can Be Corrected." & Chr(13) & Chr(13) & _
  93.        " For Further Help Contact Arvinder@Sehmi.co.uk", vbOKOnly, "Error, Missing File."
  94. End
  95. End Sub
  96. Public Sub ThisDir()
  97.  ChDrive App.Path
  98.  ChDir App.Path
  99. End Sub
  100. ' Sub Is Used Load Pictures ( *.img ) into PicClips
  101. Public Sub LoadAniPic(Destination As Object, SourceImg As PictureClip, Cell As Integer)
  102.  On Error Resume Next
  103.  LoadPercent = LoadPercent + 1
  104.  TrainLoadUp.Caption = LoadPercent
  105.  TrainLoadUp.Refresh
  106.  TrainLoadUp.CurrLoad.Caption = "Loading Animated Pictures..."
  107.  Destination.Picture = SourceImg.GraphicCell(Cell)
  108. End Sub
  109. Public Sub Highlight(Label As Label)
  110.  If Label.Tag = "no" Then
  111.  WAVPlay "click.qbs"
  112.  Label.Tag = "yes"
  113.  Label.Left = Label.Left - 10
  114.  Label.FontSize = Label.FontSize + 5
  115.  Label.ForeColor = RGB(0, 255, 0)
  116.  End If
  117. End Sub
  118. Public Sub UnHighlight(Label As Label)
  119.  If Label.Tag = "yes" Then
  120.  Label.Tag = "no"
  121.  Label.Left = Label.Left + 10
  122.  Label.FontSize = Label.FontSize - 5
  123.  Label.ForeColor = RGB(0, 90, 0)
  124.  Else
  125.  Label.Tag = "no"
  126.  End If
  127. End Sub
  128. Public Sub Delay(TimeToPause As Single) ' Waits
  129.  Dim TT As Double
  130.  TT = Timer
  131.  Do
  132.   DoEvents
  133.  Loop Until Timer > TT + TimeToPause
  134. End Sub
  135. Public Sub Sleep(TimeToPause As Single) ' stops
  136.  Dim TT As Double
  137.  TT = Timer
  138.  Do
  139.  Loop Until Timer > TT + TimeToPause
  140. End Sub
  141. ' Increase Ball Speed
  142. ' change the "SpeedToAdd" variable to two or three to make the game harder
  143. ' for pc's that are 200 mhz or less the speed should be set to 2, not 1
  144. ' if your pc is higher then 300 mhz then the speed should be set to 1
  145. Public Sub IncSpeed(Optional SpeedToAdd As Integer = 1)
  146. Dim XorY As Integer
  147. Dim YSpeedTemp As Integer, XSpeedTemp As Integer
  148. Randomize Timer
  149. XorY = Int(Rnd * 2) ' gives a random value telling if X or Y sholud increase
  150. If XorY = 0 Then
  151.  If XSpeed > 0 Then XSpeed = XSpeed + SpeedToAdd Else XSpeed = XSpeed - SpeedToAdd
  152.    XSpeedTemp = XSpeed ' inc X speed
  153.   If XSpeedTemp > 0 Then XSpeedTemp = XSpeedTemp Else XSpeedTemp = -XSpeedTemp
  154.  ElseIf XorY = 1 Then
  155.   If YSpeed > 0 Then YSpeed = YSpeed + SpeedToAdd Else YSpeed = YSpeed - SpeedToAdd
  156.    YSpeedTemp = YSpeed ' inc Y speed
  157.   If YSpeedTemp > 0 Then YSpeedTemp = YSpeedTemp Else YSpeedTemp = -YSpeedTemp
  158. End If
  159. End Sub
  160.